perm filename PERSP.OLD[CMS,LCS]1 blob
sn#719081 filedate 1983-07-04 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 IMPLICIT INTEGER(X,Y,Z)
C00007 ENDMK
Cā;
IMPLICIT INTEGER(X,Y,Z)
DIMENSION X1(800),Y1(800),Z1(800)
DIMENSION X2(800),Y2(800),Z2(800)
DIMENSION X3(800),Y3(800)
1 ,JJ(4000)
JHALF=0
1 FORMAT(' TYPE INPUT NAME 1 '$)
2 FORMAT(' TYPE INPUT NAME 2 '$)
3 FORMAT(' TYPE OUTPUT NAME '$)
6 FORMAT(A5)
7 FORMAT(4I)
8 FORMAT(' TYPE X,Y FOR VANISHING POINT. '$)
9 FORMAT(' TYPE FORESHORTENING FACTOR. '$)
13 FORMAT(F)
4 TYPE 1
ACCEPT 6,NM1
TYPE 2
ACCEPT 6,NM2
20 REWIND 1
REWIND 20
CALL IFILE(1,NM1)
CALL IFILE(20,NM2)
DO 30 KT=1,800
30 READ(1,7,END=21)LT,X1(KT),Y1(KT),Z1(KT)
C NOW KT = TOTAL VECTORS +1
21 J=X2(1)
JB=J
LB=Y2(1)
LT=L
DO 40 K=1,800
READ(20,7,END=22)LT,X2(K),Y2(K),Z2(K)
N=X2(K)
IF(N.LT.J)J=N
IF(N.GT.JB)JB=N
C ASSUMES BASE LINE IS LEVEL FOR NOW
N=Y2(K)
IF(N.LT.LB)LB=N
40 IF(N.GT.LT)LT=N
C GETS TOP AND BOT. LT,LB
22 K=K-1
CC IF(LB.GE.0)GO TO 200
CC DO 201 J=1,K
CC201 Y2(J)=Y2(J)-LB
CC DO 202 J=1,KT-1
CC202 Y1(J)=Y1(J)-LB
C SHIFT ALL TO Y POSITIVE IF ANY NEG POINTS
200 CALL DPYSET(1,JJ,4000)
CALL DRWIT(X2,Y2,Z2,K)
CALL DRWIT(X1,Y1,Z1,KT-1)
23 FORMAT(' HORIZONTAL POINTS ARE ',2I4)
24 FORMAT(' VERTICAL POINTS ARE ',2I4)
TYPE 23,J,JB
TYPE 24,LB,LT
AX=LB
BX=LT
AY=J
BY=JB
TYPE 8
ACCEPT 7,X,Y
CALL AIVECT(X2(K)-100,Y2(K))
CALL AVECT(X-100,Y)
CALL AVECT(X2(1)-100,Y2(1))
CALL DPYOUT(1)
C SHOWS VANISHING POINT
TYPE 9
ACCEPT 13,F
HA=Y2(K)-Y
C HEIGHT FROM VP TO TOP OF RECT.
HB=Y2(1)-Y
C HEIGHT FROM VP TO BOT OF RECT.
DL=X-X2(1)
C LENGTH FROM LEFT EDGE OF RECT. TO VP
M1=1
M2=1
C GET FIRST POINTS
C G,LT=TOP OF RECT. H,LB=BOT OF RECT.
G=LT
H=LB
D=G-H
C D=HEIGHT OF RECT.
10 RZ=(Y1(M1)-LB)/D
C RZ= THIS POINT % OF HEIGHT IN RECT.
C NOW FIND HEIGHT IN RE. TO VANISHING POINT.
XA=X-X1(M1)
XA=XA*(XA**F)/(DL**F)
A=XA/DL
CCC A=(X-X1(M1))/DL
C THIS POINT'S % OF THAT LENGTH
11 RQ=A*HA+Y
C POINT OF INTERSECTION WITH TOP LINE TO VP
RR=A*HB+Y
C POINT OF INTERSECTION WITH BOT LINE TO VP
DQ=RQ-RR
C LENGTH OF INTERSECTING VERTICAL SEGMENT
LY=RZ*DQ+RR
IF(IABS(LY).GE.1000)JHALF=-1
Y3(M1)=LY
C VERTICAL POINT, SCALED TO VP.
LX=X-XA
IF(IABS(LX).GE.1000)JHALF=-1
X3(M1)=LX
CCC X3(M1)=X1(M1)
C NO X CHAGE FOR TIME BEING
12 M1=M1+1
IF(M1.LT.KT)GO TO 10
CALL DRWIT(X3,Y3,Z1,KT-1)
300 FORMAT(' WRITE FILE? ')
TYPE 300
ACCEPT 6,J
IF(J.NE.'Y')GO TO 301
TYPE 3
ACCEPT 6,J
CALL OFILE(21,J)
IF(JHALF.NE.0)GO TO 304
DO 302 J=1,KT-1
302 WRITE(21,7)J,X3(J),Y3(J),Z1(J)
C WRITES FILE TO BE USED WITH 'RE' IN THE DRW PROGRAM.
303 JHALF=0
END FILE 21
301 CALL HYDPOG(1)
GO TO 200
304 DO 305 J=1,KT-1
C HALF SIZE IF X OR Y .GE.1000
LX=X3(J)/2
LY=Y3(J)/2
305 WRITE(21,7)J,LX,LY,Z1(J)
GO TO 303
END
SUBROUTINE DRWIT(X,Y,Z,K)
INTEGER X,Y,Z
DIMENSION X(1),Y(1),Z(1)
DO 1 J=1,K
IF(Z(J).EQ.0)GO TO 2
CALL AIVECT(X(J)-100,Y(J))
GO TO 1
2 CALL AVECT(X(J)-100,Y(J))
1 CONTINUE
CALL DPYOUT(1)
END